(*--------------------------------------------------------
    Holt                  http://coderesearchlabs.com/holt
    by Javier Santo Domingo (j-a-s-d@coderesearchlabs.com)
  --------------------------------------------------------
    tree
  --------------------------------------------------------*)

unit holt_tree;

{$I holt_defines.inc}

interface

uses
  holt_architecture,
  holt_types;

function NewTree: IhTree;

implementation

uses
  holt_consts;

{ ThTreeNode }

type
  ThTreeNodes = array of IhTreeNode;

  ThTreeNode = class(TInterfacedObject, IhTreeNode)
  strict private
    FName: gString;
    FValue: gString;
    FKind: gString;
    FParent: IhTreeNode;
    FChildNodes: ThTreeNodes;
    function GetChildNodesAsCSV: gString;
  strict protected
    function AsCommands: gString;
    function AsText: gString;
    function Search(const AText: gString): gString;
    function GetPosition: gNumber;
    function GetLevel: gNumber;
    function GetPath: gString;
    function GetParent: IhTreeNode;
    function GetName: gString;
    function GetValue: gString;
    function GetKind: gString;
    procedure SetParent(ANode: IhTreeNode);
    procedure SetName(const AName: gString);
    procedure SetValue(const AValue: gString);
    procedure SetKind(const AKind: gString);
    function IncludeChild(ANode: IhTreeNode): gBoolean;
    function ExcludeChild(ANode: IhTreeNode): gBoolean;
    function GetNamedChild(const AName: gString): IhTreeNode;
    function GetChild(AIndex: gNumber): IhTreeNode;
    function IsRoot: gBoolean;
    function GetRoot: IhTreeNode;
    function GetInfo: gString;
    function GetChildPosition(ANode: IhTreeNode): gNumber;
    function GetChildNodesCount: gNumber;
    procedure ClearChildNodes;
    procedure FlipChildNodes;
    function UpNamedChild(const AName: gString): gBoolean;
    function DownNamedChild(const AName: gString): gBoolean;
  end;

function ThTreeNode.GetChildNodesCount: gNumber;
begin
  result := Length(FChildNodes);
end;

function ThTreeNode.GetChild(AIndex: gNumber): IhTreeNode;
begin
  if (Length(FChildNodes) > 0) and (AIndex < Length(FChildNodes)) then
    result := FChildNodes[AIndex]
  else
    result := nil;
end;

procedure ThTreeNode.ClearChildNodes;
var index: gNumber;
begin
  if Length(FChildNodes) > 0 then
    for index := 0 to Length(FChildNodes)-1 do begin
      FChildNodes[index].ClearChildNodes;
      FChildNodes[index] := nil;
    end;
  SetLength(FChildNodes, 0);
end;

procedure ThTreeNode.FlipChildNodes;
var index, top: gNumber; tmp: ThTreeNodes;
begin
  top := Length(FChildNodes)-1;
  SetLength(tmp, top+1);
  for index := 0 to top do
    tmp[top - index] := FChildNodes[index];
  FChildNodes := tmp;
end;

function ThTreeNode.UpNamedChild(const AName: gString): gBoolean;
var index: gNumber; temp: IhTreeNode;
begin
  result := false;
  if Length(FChildNodes) > 0 then
    for index := 0 to Length(FChildNodes)-1 do
      if index > 0 then
        if FChildNodes[index].GetName = AName then begin
          temp := FChildNodes[index-1];
          FChildNodes[index-1] := FChildNodes[index];
          FChildNodes[index] := temp;
          result := true;
          break;
        end;
end;

function ThTreeNode.DownNamedChild(const AName: gString): gBoolean;
var index: gNumber; temp: IhTreeNode;
begin
  result := false;
  if Length(FChildNodes) > 0 then
    for index := 0 to Length(FChildNodes)-1 do
      if index < Length(FChildNodes)-1 then
        if FChildNodes[index].GetName = AName then begin
          temp := FChildNodes[index+1];
          FChildNodes[index+1] := FChildNodes[index];
          FChildNodes[index] := temp;
          result := true;
          break;
        end;
end;

function ThTreeNode.GetChildPosition(ANode: IhTreeNode): gNumber;
var index: gNumber;
begin
  result := 0;
  if Length(FChildNodes) > 0 then
    for index := 0 to Length(FChildNodes)-1 do
      if FChildNodes[index] = ANode then begin
        result := index+1;
        break;
      end;
end;

function ThTreeNode.IsRoot: gBoolean;
begin
  result := FParent = nil;
end;

function ThTreeNode.GetChildNodesAsCSV: gString;
var node: IhTreeNode;
begin
  result := '';
  for node in FChildNodes do
    result := result + COMMA + node.GetName;
  if result <> '' then
    Delete(result, 1, 1);
end;

function ThTreeNode.GetInfo: gString;
var lLevel, lPosition: gString;
begin
  Str(GetLevel, lLevel);
  Str(GetPosition, lPosition);
  result :=
    MSG_LEVEL + '=' + lLevel + LineEnding +
    MSG_POSITION + '=' + lPosition + LineEnding +
    MSG_NAME + '=' + FName + LineEnding +
    MSG_VALUE + '=' + FValue + LineEnding +
    MSG_KIND + '='+ FKind + LineEnding +
    MSG_CHILDREN + '=' + GetChildNodesAsCSV;
end;

function ThTreeNode.GetPath: gString;
begin
  if FParent = nil then
    result := FName + SLASH
  else
    result := FParent.GetPath + FName + SLASH;
end;

function ThTreeNode.GetPosition: gNumber;
begin
  if FParent = nil then
    result := 1
  else
    result := FParent.GetChildPosition(Self);
end;

function ThTreeNode.GetLevel: gNumber;
var path: gString; c: gChar;
begin
  result := 0;
  path := GetPath;
  for c in path do
    if c = SLASH then
      result += 1;
end;

function ThTreeNode.GetParent: IhTreeNode;
begin
  result := FParent;
end;

function ThTreeNode.GetName: gString;
begin
  result := FName;
end;

function ThTreeNode.GetValue: gString;
begin
  result := FValue;
end;

function ThTreeNode.GetKind: gString;
begin
  result := FKind;
end;

procedure ThTreeNode.SetParent(ANode: IhTreeNode);
begin
  FParent := ANode;
end;

procedure ThTreeNode.SetName(const AName: gString);
begin
  FName := AName;
end;

procedure ThTreeNode.SetValue(const AValue: gString);
begin
  FValue := AValue;
end;

procedure ThTreeNode.SetKind(const AKind: gString);
begin
  FKind := AKind;
end;

function ThTreeNode.IncludeChild(ANode: IhTreeNode): gBoolean;
var index: gNumber;
begin
  result := true;
  try
    index := Length(FChildNodes);
    SetLength(FChildNodes, index+1);
    FChildNodes[index] := ANode;
  except
    result := false;
  end;
end;

function ThTreeNode.ExcludeChild(ANode: IhTreeNode): gBoolean;

  procedure deleteChild(AIndex: gNumber); inline;
  var count: gNumber;
  begin
    count := Length(FChildNodes);
    Move(FChildNodes[AIndex+1], FChildNodes[AIndex], (count-AIndex) * SizeOf(IhTreeNode));
    Initialize(FChildNodes[count-1]);
    SetLength(FChildNodes, count-1);
  end;

var index: gNumber;
begin
  result := false;
  for index := 0 to Length(FChildNodes)-1 do
    if FChildNodes[index] = ANode then begin
      deleteChild(index);
      result := true;
      break;
    end;
end;

function ThTreeNode.GetNamedChild(const AName: gString): IhTreeNode;
var node: IhTreeNode;
begin
  result := nil;
  for node in FChildNodes do
    if node.GetName = AName then begin
      result := node;
      break;
    end;
end;

function ThTreeNode.Search(const AText: gString): gString;

  function searchChildNodes(ATreeNode: IhTreeNode): gString; inline;
  var index, count: gNumber;
  begin
    result := '';
    if ATreeNode <> nil then
      with ATreeNode do begin
        if Pos(AText, GetName) > 0 then
          result += GetPath + LineEnding;
        count := GetChildNodesCount;
        if count > 0 then
          for index := 0 to count - 1 do
            result += searchChildNodes(GetChild(index));
      end;
  end;

begin
  result := searchChildNodes(Self);
end;

function ThTreeNode.AsText: gString;

  function displayChildNodes(ATreeNode: IhTreeNode): gString; //inline;

    function doIndent(ALevel: gNumber): gString; inline;
    begin
      result := '';
      while ALevel > 0 do begin
        result += INDENT;
        ALevel -= 1;
      end;
    end;

  var index, count: gNumber;
  begin
    result := '';
    if ATreeNode <> nil then
      with ATreeNode do begin
        result += doIndent(GetLevel - 1) + GetName + LineEnding;
        count := GetChildNodesCount;
        if count > 0 then
          for index := 0 to count - 1 do
            result += DisplayChildNodes(GetChild(index));
      end;
  end;

begin
  result := displayChildNodes(Self);
end;

function ThTreeNode.AsCommands: gString;
var node: IhTreeNode;
begin
  result := FName + LineEnding;
  if FValue <> '' then
    result += OPCODE_VALUE + ' ' + FValue + LineEnding;
  if FKind <> '' then
    result += OPCODE_KIND + ' ' + FKind + LineEnding;
  for node in FChildNodes do
    result += node.AsCommands;
  if not IsRoot then
    result += OPCODE_PARENT + LineEnding;
end;

function ThTreeNode.GetRoot: IhTreeNode;
begin
  if IsRoot then
    result := Self
  else
    result := FParent.GetRoot;
end;

function NewTreeNode(AName: gString; AParent: IhTreeNode = nil): IhTreeNode;
begin
  result := ThTreeNode.Create;
  result.SetName(ANAme);
  result.SetParent(AParent);
  if assigned(AParent) then
    if (AParent.GetNamedChild(AName) <> nil) then
      result := nil
    else
      AParent.IncludeChild(result);
end;

{ ThTree }

type
  ThTree = class(TInterfacedObject, IhTree)
  strict private
    FNode: IhTreeNode;
    function GetCurrentNode: IhTreeNode;
    function GetNodeByPath(const APath: gString): IhTreeNode;
    function GotoPath(const APath: gString): gBoolean;
    function GotoRoot: gBoolean;
    function GotoParent: gBoolean;
    function GotoChild(const AChildName: gString): gBoolean;
    function GetPath: gString;
    function GetLevel: gNumber;
    function AddChild(const AName: gString): gBoolean;
    function DeleteChild(const AName: gString): gBoolean;
    function SetName(const AName: gString): gBoolean;
    function SetValue(const AValue: gString): gBoolean;
    function SetKind(const AKind: gString): gBoolean;
    function GetInfo: gString;
    function Truncate: gBoolean;
    function Flip: gBoolean;
    function UpChild(const AName: gString): gBoolean;
    function DownChild(const AName: gString): gBoolean;
    function Drop: gBoolean;
    function Rebase: gBoolean;
    function AsCommands: gString;
    function AsText: gString;
    function Search(const AText: gString): gString;
  end;

function ThTree.GetCurrentNode: IhTreeNode;
begin
  if assigned(FNode) then
    result := FNode
  else
    result := nil;
end;

function ThTree.GetNodeByPath(const APath: gString): IhTreeNode;

  function fetchNodeByPath(ATreeNode: IhTreeNode; APath: gString): IhTreeNode;

    function isSamePath(ATreePath, AUserPath: gString): gBoolean; inline;
    begin
      result := (ATreePath = AUserPath) or (ATreePath = AUserPath + SLASH);
    end;

  var index, count: gNumber;
  begin
    result := nil;
    if ATreeNode <> nil then
      with ATreeNode do
        if isSamePath(GetPath, APath) then
          result := ATreeNode
        else begin
          count := GetChildNodesCount;
          if count > 0 then
            for index := 0 to count - 1 do
              if not assigned(result) then
                result := fetchNodeByPath(GetChild(index), APath);
        end;
  end;

begin
  result := fetchNodeByPath(FNode.GetRoot, APath);
end;

function ThTree.GotoPath(const APath: gString): gBoolean;
var lNode: IhTreeNode;
begin
  lNode := GetNodeByPath(APath);
  result := assigned(lNode);
  if result then
  try
    FNode := lNode
  except
    result := false;
  end;
end;

function ThTree.AddChild(const AName: gString): gBoolean;
begin
  result := true;
  try
    if not assigned(FNode) then
      FNode := NewTreeNode(AName)
    else
      result := assigned(NewTreeNode(AName, FNode));
  except
    result := false;
  end;
end;

function ThTree.DeleteChild(const AName: gString): gBoolean;
var node: IhTreeNode;
begin
  result := false;
  if assigned(FNode) then begin
    node := FNode.GetNamedChild(AName);
    if assigned(node) then
      result := FNode.ExcludeChild(node);
  end;
end;

function ThTree.SetName(const AName: gString): gBoolean;
begin
  result := assigned(FNode);
  if result then
  try
    FNode.SetName(AName);
  except
    result := false;
  end;
end;

function ThTree.SetValue(const AValue: gString): gBoolean;
begin
  result := assigned(FNode);
  if result then
  try
    FNode.SetValue(AValue);
  except
    result := false;
  end;
end;

function ThTree.SetKind(const AKind: gString): gBoolean;
begin
  result := assigned(FNode);
  if result then
  try
    FNode.SetKind(AKind);
  except
    result := false;
  end;
end;

function ThTree.GetInfo: gString;
begin
  if assigned(FNode) then
    result := FNode.GetInfo + LineEnding
  else
    result := '';
end;

function ThTree.GetLevel: gNumber;
begin
  if assigned(FNode) then
    result := FNode.GetLevel
  else
    result := 0;
end;

function ThTree.GetPath: gString;
begin
  if assigned(FNode) then
    result := FNode.GetPath
  else
    result := '';
end;

function ThTree.GotoRoot: gBoolean;
begin
  result := assigned(FNode);
  if result then
  try
    FNode := FNode.GetRoot
  except
    result := false;
  end;
end;

function ThTree.GotoParent: gBoolean;
begin
  result := assigned(FNode) and (not FNode.IsRoot);
  if result then
  try
    FNode := FNode.GetParent;
  except
    result := false;
  end;
end;

function ThTree.GotoChild(const AChildName: gString): gBoolean;
var node: IhTreeNode;
begin
  result := true;
  try
    if not assigned(FNode) then
      AddChild(AChildName)
    else begin
      node := FNode.GetNamedChild(AChildName);
      if not assigned(node) then begin
        AddChild(AChildName);
        node := FNode.GetNamedChild(AChildName);
      end;
      FNode := node;
    end;
  except
    result := false;
  end;
end;

function ThTree.UpChild(const AName: gString): gBoolean;
begin
  if assigned(FNode) then
    result := FNode.UpNamedChild(AName)
  else
    result := false;
end;

function ThTree.DownChild(const AName: gString): gBoolean;
begin
  if assigned(FNode) then
    result := FNode.DownNamedChild(AName)
  else
    result := false;
end;

function ThTree.Flip: gBoolean;
begin
  result := assigned(FNode);
  if result then
  try
    FNode.FlipChildNodes;
  except
    result := false;
  end;
end;

function ThTree.Truncate: gBoolean;
begin
  result := assigned(FNode);
  if result then
  try
    FNode.ClearChildNodes;
  except
    result := false;
  end;
end;

function ThTree.Rebase: gBoolean;
var newRoot: IhTreeNode;
begin
  result := assigned(FNode);
  if result then begin
    newRoot := FNode;
    if GotoRoot then begin
      newRoot.SetParent(nil);
      FNode := nil;
      FNode := newRoot;
    end;
  end;
end;

function ThTree.Drop: gBoolean;
begin
  result := GotoRoot;
  if result then
  try
    FNode.ClearChildNodes;
    FNode := nil;
  except
    result := false;
  end;
end;

function ThTree.AsCommands: gString;
begin
  if assigned(FNode) then
    result := FNode.AsCommands
  else
    result := '';
end;

function ThTree.AsText: gString;
begin
  if assigned(FNode) then
    result := FNode.AsText
  else
    result := '';
end;

function ThTree.Search(const AText: gString): gString;
begin
  if assigned(FNode) then
    result := FNode.Search(AText)
  else
    result := '';
end;

function NewTree: IhTree;
begin
  result := ThTree.Create;
end;

end.
